REBOL [Title: "Templates  für bean-xml"]

bean-result-entry: [
    " ^/  " 
    void [
        "void" a [index "0"] b []
    ]
] 
bean-result-template: [
    java [
        "java" a [version "1.5.0_11" class "java.beans.XMLDecoder"] b [
            " ^/ " 
            array [
                "array" a [class "java.lang.Object" length "54"] b []
            ] " ^/"
        ]
    ]
] 
bean-templates: [tuple! [
        "object" a [class "rebol.eclipse.plugin.xml.rebol.Tuple"] b [
            " ^/    " 
            void [
                "void" a [property "tuple"] b [
                    " ^/     " 
                    array [
                        "array" a [class "byte" length "2"] b [
                            " ^/      " 
                            void [
                                "void" a [index "0"] b [
                                    " ^/       " 
                                    byte [
                                        "byte" a #[none] b ["1"]
                                    ] " ^/      "
                                ]
                            ] " ^/      " 
                            void [
                                "void" a [index "1"] b [
                                    " ^/       " 
                                    byte [
                                        "byte" a #[none] b ["2"]
                                    ] " ^/      "
                                ]
                            ] " ^/     "
                        ]
                    ] " ^/    "
                ]
            ] " ^/   "
        ]
    ] byte! [
        "byte" a #[none] b ["0"]
    ] word! [
        "string" a #[none] b ["a Word"]
    ] integer! [
        "int" a #[none] b ["0"]
    ] decimal! [
        "double" a #[none] b ["0.0"]
    ] string! [
        "object" a [class "rebol.eclipse.plugin.xml.rebol.RString"] b [
            " ^/    " 
            void [
                "void" a [property "string"] b [
                    " ^/     " 
                    string [
                        "string" a #[none] b ["a String"]
                    ] " ^/    "
                ]
            ] " ^/   "
        ]
    ] pair! [
        "object" a [class "java.awt.Point"] b [
            " ^/    " 
            int [
                "int" a #[none] b ["1"]
            ] " ^/    " 
            int [
                "int" a #[none] b ["2"]
            ] " ^/   "
        ]
    ] block! [
        "array" a [class "java.lang.Object" length "1"] b [
            " ^/    " 
            void [
                "void" a [index "0"] b [
                    " ^/     " 
                    int [
                        "int" a #[none] b ["1"]
                    ] " ^/    "
                ]
            ] " ^/   "
        ]
    ] word! [
        "object" a [class "rebol.eclipse.plugin.xml.rebol.Word"] b [
            " ^/    " 
            void [
                "void" a [property "string"] b [
                    " ^/     " 
                    string [
                        "string" a #[none] b ["a Word"]
                    ] " ^/    "
                ]
            ] " ^/   "
        ]
    ] get-word! [
        "object" a [class "rebol.eclipse.plugin.xml.rebol.GetWord"] b [
            " ^/    " 
            void [
                "void" a [property "string"] b [
                    " ^/     " 
                    string [
                        "string" a #[none] b ["a Word"]
                    ] " ^/    "
                ]
            ] " ^/   "
        ]
    ] set-word! [
        "object" a [class "rebol.eclipse.plugin.xml.rebol.SetWord"] b [
            " ^/    " 
            void [
                "void" a [property "string"] b [
                    " ^/     " 
                    string [
                        "string" a #[none] b ["a Word"]
                    ] " ^/    "
                ]
            ] " ^/   "
        ]
    ] lit-word! [
        "object" a [class "rebol.eclipse.plugin.xml.rebol.LitWord"] b [
            " ^/    " 
            void [
                "void" a [property "string"] b [
                    " ^/     " 
                    string [
                        "string" a #[none] b ["a Word"]
                    ] " ^/    "
                ]
            ] " ^/   "
        ]
    ] refinement! [
        "object" a [class "rebol.eclipse.plugin.xml.rebol.Refinement"] b [
            " ^/    " 
            void [
                "void" a [property "string"] b [
                    " ^/     " 
                    string [
                        "string" a #[none] b ["a Word"]
                    ] " ^/    "
                ]
            ] " ^/   "
        ]
    ] url! [
        "object" a [class "rebol.eclipse.plugin.xml.rebol.RURL"] b [
            " ^/    " 
            void [
                "void" a [property "string"] b [
                    " ^/     " 
                    string [
                        "string" a #[none] b ["a String"]
                    ] " ^/    "
                ]
            ] " ^/   "
        ]
    ] file! [
        "object" a [class "rebol.eclipse.plugin.xml.rebol.RFile"] b [
            " ^/    " 
            void [
                "void" a [property "string"] b [
                    " ^/     " 
                    string [
                        "string" a #[none] b ["a String"]
                    ] " ^/    "
                ]
            ] " ^/   "
        ]
    ] issue! [
        "object" a [class "rebol.eclipse.plugin.xml.rebol.Issue"] b [
            " ^/    " 
            void [
                "void" a [property "string"] b [
                    " ^/     " 
                    string [
                        "string" a #[none] b ["a String"]
                    ] " ^/    "
                ]
            ] " ^/   "
        ]
    ] tag! [
        "object" a [class "rebol.eclipse.plugin.xml.rebol.RTag"] b [
            " ^/    " 
            void [
                "void" a [property "string"] b [
                    " ^/     " 
                    string [
                        "string" a #[none] b ["a String"]
                    ] " ^/    "
                ]
            ] " ^/   "
        ]
    ] email! [
        "object" a [class "rebol.eclipse.plugin.xml.rebol.EMail"] b [
            " ^/    " 
            void [
                "void" a [property "string"] b [
                    " ^/     " 
                    string [
                        "string" a #[none] b ["a String"]
                    ] " ^/    "
                ]
            ] " ^/   "
        ]
    ] none! [
        "object" a [class "rebol.eclipse.plugin.xml.rebol.None"] b #[none]
    ] char! [
        "char" a #[none] b ["c"]
    ] logic! [
        "boolean" a #[none] b ["true"]
    ] paren! [
        "object" a [class "rebol.eclipse.plugin.xml.rebol.Paren"] b [
            " ^/    " 
            void [
                "void" a [property "series"] b [
                    " ^/     " 
                    array [
                        "array" a [class "java.lang.Object" length "1"] b [
                            " ^/      " 
                            void [
                                "void" a [index "0"] b [
                                    " ^/       " 
                                    string [
                                        "string" a #[none] b ["empty"]
                                    ] " ^/      "
                                ]
                            ] " ^/     "
                        ]
                    ] " ^/    "
                ]
            ] " ^/   "
        ]
    ] path! [
        "object" a [class "rebol.eclipse.plugin.xml.rebol.Path"] b [
            " ^/    " 
            void [
                "void" a [property "series"] b [
                    " ^/     " 
                    array [
                        "array" a [class "java.lang.Object" length "1"] b [
                            " ^/      " 
                            void [
                                "void" a [index "0"] b [
                                    " ^/       " 
                                    string [
                                        "string" a #[none] b ["empty"]
                                    ] " ^/      "
                                ]
                            ] " ^/     "
                        ]
                    ] " ^/    "
                ]
            ] " ^/   "
        ]
    ] set-path! [
        "object" a [class "rebol.eclipse.plugin.xml.rebol.SetPath"] b [
            " ^/    " 
            void [
                "void" a [property "series"] b [
                    " ^/     " 
                    array [
                        "array" a [class "java.lang.Object" length "1"] b [
                            " ^/      " 
                            void [
                                "void" a [index "0"] b [
                                    " ^/       " 
                                    string [
                                        "string" a #[none] b ["empty"]
                                    ] " ^/      "
                                ]
                            ] " ^/     "
                        ]
                    ] " ^/    "
                ]
            ] " ^/   "
        ]
    ] lit-path! [
        "object" a [class "rebol.eclipse.plugin.xml.rebol.LitPath"] b [
            " ^/    " 
            void [
                "void" a [property "series"] b [
                    " ^/     " 
                    array [
                        "array" a [class "java.lang.Object" length "1"] b [
                            " ^/      " 
                            void [
                                "void" a [index "0"] b [
                                    " ^/       " 
                                    string [
                                        "string" a #[none] b ["empty"]
                                    ] " ^/      "
                                ]
                            ] " ^/     "
                        ]
                    ] " ^/    "
                ]
            ] " ^/   "
        ]
    ] time! [
        "object" a [class "rebol.eclipse.plugin.xml.rebol.RTime"] b [
            " ^/    " 
            void [
                "void" a [property "string"] b [
                    " ^/     " 
                    string [
                        "string" a #[none] b ["01:00:01"]
                    ] " ^/    "
                ]
            ] " ^/   "
        ]
    ] date! [
        "object" a [class "java.util.Date"] b [
            " ^/    " 
            long [
                "long" a #[none] b ["1179155981180"]
            ] " ^/   "
        ]
    ]] 
mark-record: func [blk ofs] [
    new-line skip tail blk negate ofs true
] 
bean-to-val: func [bean-tag /local val] [
    switch/default bean-tag/1 [
        "byte" [to byte! bean-tag/b/1] 
        "string" [to word! bean-tag/b/1] 
        "int" [to integer! bean-tag/b/1] 
        "double" [to decimal! bean-tag/b/1] 
        "array" [val: bean-tag . beans-to-rebol val] 
        "char" [to char! bean-tag/b/1] 
        "boolean" [val: bean-tag/b/1 . get first find [true false] to-word val] 
        "object" [
            switch/default bean-tag/a/class [
                "rebol.eclipse.plugin.xml.rebol.Tuple" [val: bean-tag/b/void/b/array . to-tuple probe beans-to-rebol ?? val] 
                "rebol.eclipse.plugin.xml.rebol.RString" [val: bean-tag/b . get-bean-string val] 
                "java.awt.Point" [val: bean-tag/b . val: by-mark val 'int . as-pair to-integer val/1/b/1 to-integer val/2/b/1] 
                "rebol.eclipse.plugin.xml.rebol.Word" [val: bean-tag/b . to-word get-bean-string val] 
                "rebol.eclipse.plugin.xml.rebol.GetWord" [val: bean-tag/b . to-get-word get-bean-string val] 
                "rebol.eclipse.plugin.xml.rebol.SetWord" [val: bean-tag/b . to-set-word get-bean-string val] 
                "rebol.eclipse.plugin.xml.rebol.LitWord" [val: bean-tag/b . to-lit-word get-bean-string val] 
                "rebol.eclipse.plugin.xml.rebol.Refinement" [val: bean-tag/b . to-refinement get-bean-string val] 
                "rebol.eclipse.plugin.xml.rebol.RURL" [val: bean-tag/b . to-url get-bean-string val] 
                "rebol.eclipse.plugin.xml.rebol.RFile" [val: bean-tag/b . to-file get-bean-string val] 
                "rebol.eclipse.plugin.xml.rebol.Issue" [val: bean-tag/b . to-issue get-bean-string val] 
                "rebol.eclipse.plugin.xml.rebol.RTag" [val: bean-tag/b . to-tag get-bean-string val] 
                "rebol.eclipse.plugin.xml.rebol.EMail" [val: bean-tag/b . to-email get-bean-string val] 
                "rebol.eclipse.plugin.xml.rebol.None" [val: bean-tag . none] 
                "rebol.eclipse.plugin.xml.rebol.Paren" [val: bean-tag/b/void/b/array . to-paren new-line/all beans-to-rebol val false] 
                "rebol.eclipse.plugin.xml.rebol.Path" [val: bean-tag/b/void/b/array . to-path new-line/all beans-to-rebol val false] 
                "rebol.eclipse.plugin.xml.rebol.SetPath" [val: bean-tag/b/void/b/array . to-set-path new-line/all beans-to-rebol val false] 
                "rebol.eclipse.plugin.xml.rebol.LitPath" [val: bean-tag/b/void/b/array . to-lit-path new-line/all beans-to-rebol val false] 
                "rebol.eclipse.plugin.xml.rebol.RTime" [val: bean-tag/b . to-time get-bean-string val] 
                "java.util.Date" [val: bean-tag/b/long/b/1 . to-reb-date val]
            ] [make error! join "unknown own bean: " bean-tag/a/class]
        ]
    ] [make error! join "unknown inbuild bean: " bean-tag/1]
] 
val-to-bean: func [val /local type bean-tag target] [
    type: type?/word :val 
    bean-tag: copy/deep select bean-templates type 
    switch/default type [
        tuple! [target: bean-tag/b/void/b/array . insert clear target to-bean-tuple load replace/all mold val "." " "] 
        byte! [bean-tag/b/1: make error! "no bytes in rebol"] 
        word! [bean-tag/b/1: mold val] 
        integer! [bean-tag/b/1: mold val] 
        decimal! [bean-tag/b/1: mold val] 
        string! [target: bean-tag/b . set-bean-string target form val] 
        pair! [target: bean-tag/b . target/3/b/1: mold val/x . target/6/b/1: mold val/y] 
        block! [target: bean-tag . head insert clear target to-bean-array val] 
        word! [target: bean-tag/b . set-bean-string target form val] 
        get-word! [target: bean-tag/b . set-bean-string target form val] 
        set-word! [target: bean-tag/b . set-bean-string target form val] 
        lit-word! [target: bean-tag/b . set-bean-string target form val] 
        refinement! [target: bean-tag/b . set-bean-string target form val] 
        url! [target: bean-tag/b . set-bean-string target form val] 
        file! [target: bean-tag/b . set-bean-string target form val] 
        issue! [target: bean-tag/b . set-bean-string target form val] 
        tag! [target: bean-tag/b . set-bean-string target form val] 
        email! [target: bean-tag/b . set-bean-string target form val] 
        none! [target: bean-tag .] 
        char! [bean-tag/b/1: to-string val] 
        logic! [bean-tag/b/1: mold val] 
        paren! [target: bean-tag/b/void/b/array . insert clear target to-bean-array val] 
        path! [target: bean-tag/b/void/b/array . insert clear target to-bean-array val] 
        set-path! [target: bean-tag/b/void/b/array . insert clear target to-bean-array val] 
        lit-path! [target: bean-tag/b/void/b/array . insert clear target to-bean-array val] 
        time! [target: bean-tag/b . set-bean-string target form val] 
        date! [target: bean-tag/b/long/b/1 . to-bean-date target val]
    ] [
        make error! join "Unbekannter Typ: " remold [
            type? val 
            val
        ]
    ] 
    reduce [
        to-word bean-tag/1 
        bean-tag
    ]
] 
top-array: func [blk] [
    blk/b/java/b/array
] 
beans-to-rebol: func [bean-arr /local out len] [
    out: copy [] 
    len: load bean-arr/a/length 
    insert/dup out: copy [] 'unknown len 
    expand-bean-ids bean-arr/b 
    foreach entry bean-arr/b [
        if block? entry [
            ix: 1 + load entry/a/index 
            out/:ix: bean-to-val entry/b/3
        ]
    ] 
    new-line/all out true 
    out
] 
rebol-to-beans: func [blk /local out] [
    out: copy [] 
    foreach val blk [
        append out val-to-bean :val
    ] 
    out
] 
byte!: :integer! 
to-bean-entry: func [blk-at /local entry] [
    entry: copy/deep bean-result-entry 
    insert/part entry/void/b blk-at 2 
    entry/void/a/index: mold (index? blk-at) - 1 / 2 
    entry
] 
to-bean-result: func [blk /local res] [
    res: copy/deep bean-result-template 
    res/java/b/array/a/length: mold (length? blk) / 2 
    forskip blk 2 [
        append res/java/b/array/b to-bean-entry blk
    ] 
    res
] 
to-bean-array: func [blk /local res] [
    res: to-bean-result rebol-to-beans blk 
    res: res/java/b/array
] 
to-bean-tuple: func [blk /local res] [
    ??? 
    res: to-bean-array blk 
    res/a/class: "byte" 
    foreach val probe by-mark res/b 'void [
        val/b/int/1: "byte"
    ] 
    ?? 
    res
] 
expand-bean-ids: func [xml-body /local ids p id rule tag break?] [
    ids: copy [] 
    parse xml-body rule: [
        any [
            into [
                tag: string! 
                'a p: [
                    block! (
                        if id: select p/1 'id [
                            repend ids [id tag]
                        ] 
                        break?: either id: select p/1 'idref [
                            orig: select ids id 
                            tag/a: orig/a 
                            tag/b: orig/b 
                            'break
                        ] [
                            []
                        ]
                    ) break? | skip
                ] 
                'b into rule
            ] | skip
        ]
    ] 
    xml-body
] 
index-by-path: func [blk path /local out] [
    out: copy [] 
    foreach item blk [
        path/1: 'item 
        repend out [attempt [do path] item]
    ] 
    out
] 
by-path: func [blk path /local out] [
    out: copy [] 
    foreach item blk [
        path/1: 'item 
        if key: attempt [do path] [
            repend out [key item]
        ]
    ] 
    out
] 
by-mark: func [blk type /local out] [
    out: copy [] 
    while [blk: find blk type] [
        repend out [blk/2] 
        blk: skip blk 2
    ] 
    out
] 
get-property: func [val name] [
    val: by-path by-mark val 'void 'item/a/property 
    val: select val name
] 
get-bean-string: func [val] [
    val: get-property val "string" 
    val/b/string/b/1
] 
set-bean-string: func [val name] [
    val: get-property val "string" 
    val/b/string/b/1: name
] 
bean-0date: 1-Jan-1970/0:00 
to-reb-date: func [val] [
    val: copy val 
    insert skip tail val -3 "." 
    val: to-time to-decimal val 
    val: bean-0date + val + now/zone 
    val/zone: now/zone 
    val
] 
to-bean-date: func [target val] [
    val: form to-money to-decimal 1000 * difference val bean-0date 
    clear find val "." 
    val
]